Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/autofill/autofill.pas

Pascal/Delphi Source File | 1995-12-22 | 4KB | 191 lines

{Please find below source code for the simple auto fill component. This has -not-
been thoroughly tested, and I can accept no liability for it <g>. Hope it is of
interest. Please feel free to do with it what you wish, but please let me know
what you think.

Regards
Phil
}

{Unit Combo: Simple 'Auto Fill' Combo Box
To Use: Add this as a control using options menu from Delphi
Written by Phil Arundell ([e-mail])
This file is placed in the public domain


implementation note:
As this control uses a binary search, it only works on SORTED combo boxes,
which is set as the default

}

unit Combo;

interface

uses
  SysUtils,
  WinTypes,
  WinProcs,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls;

type
  TExtCombo = class(TComboBox)
  private
    { Private declarations }
  protected
    { Protected declarations }
    function BinarySearch(StringToFind: String): String;
    procedure KeyPress(var Key: Char); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property Sorted default True;
  end;

procedure Register;

implementation



procedure Register;
begin
  RegisterComponents('Samples', [TExtCombo]);
end;

constructor TExtCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Sorted := True;
end;



procedure TExtCombo.KeyPress(var Key: Char);
var
    Temp, ListText, MatchString: String;
   startpos, second, TextLen: Integer;

begin
   Inherited KeyPress (Key);

   if key in [#8,#27,#13,#9] then
      exit;

   temp := '';
   startpos := SelStart;
   second := startPos + SelLength + 1 ;
   if startpos <> 0 then
      temp := copy(Text,0, startpos);

   temp := temp + Key +
               Copy(Text, second, Length(Text) - Second + 1);
   TextLen:= Length(Temp);


   MatchString := BinarySearch(Temp);

   if MatchString <> '' Then
   begin
      Text := MatchString;
      SelStart := StartPos + 1;
      SelLength := length(ListText) - StartPos -1;
   end
   else
   begin
      Text := Temp;
      SelStart := StartPos + 1;
   end;
   key := #0;

end;


function TExtCombo.BinarySearch(StringToFind: String): String;
var
    curpos: Integer;
   MaxPos: Integer;
   MinPos: Integer;
   ItemCount: Integer;
    IncAmount: Integer;
   len: integer;
   Temp: String;

begin
    MaxPos := Items.Count -1;
   MinPos := 0;
    len := Length(StringToFind);
    result := '';
   {exit if no items in Items, or search string < lowest value or > highest
value}
   if (maxpos = -1) or
           (CompareText(StringToFind,Copy(Items[0],0,len)) <0) or
             (CompareText(StringToFind,Copy(Items[MaxPos],0,Len)) >
0) then
             exit;

    {special case for matching last string, go backwards through Items
   until earliest match is found}
   If CompareText(StringToFind, Copy(Items[MaxPos],0,Len)) = 0 Then
   begin
        while ((CompareText(StringToFind, Copy(Items[MaxPos],0,Len))= 0)
and (maxpos <>0)) do
            dec (maxpos);

       inc (MaxPos);
          Result := Items[MaxPos];
      exit;
   end;
    {special case for matching first string, exit if match found}
   If CompareText(StringToFind, Copy(Items[0],0,Len)) = 0 Then
   begin
        Result := Items[0];
      exit;
   end;

   curpos := MaxPos Div 2;
    {main binary search loop}
    while (abs(MaxPos - MinPos)<> 1) and (MaxPos <= ItemCount) Do
   begin
        temp := Items[CurPos];
        case CompareText(StringToFind,Copy(Temp,0,Len)) of
         -32767..-1:
         begin
            MaxPos := curpos;
         end;

          0:
         begin
             result := Items[CurPos];
            exit;
         end;

         1..32767:
         begin
            MinPos := CurPos;
         end;

      end;

      CurPos := MinPos + ((MaxPos - MinPos) Div 2);
      end;
end;


end.

{end of file}


{ Phil Arundell ([e-mail]) }